home *** CD-ROM | disk | FTP | other *** search
/ SPACE 1 / SPACE - Library 1 - Volume 1.iso / utilitys / 351 / multipnt / mpaint.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1989-12-31  |  44.2 KB  |  1,788 lines
  1. {$a+}
  2. {$U15}
  3. {$P-}
  4. PROGRAM MultiPaint;
  5.  
  6. {$I c:gemsubs.pas}
  7. {$I c:auxsubs.pas}
  8. {$I c:mpaint.i}
  9.  
  10.     mousestate = 79;
  11.     leftbutton = 1;
  12.     rightbutton = 2;
  13.     buttons = 3;
  14.     rightshift = 1;
  15.     leftshift = 2;
  16.     shiftkeys = 3;
  17.     control = 4;
  18.     alternate = 8;
  19.     ShiftAlt = 11;
  20.     ShiftAltCntrl = 14;
  21.     opaque_mode = 1;
  22.     transparent_mode = 2;
  23.     LoadPic = 1;
  24.     SavePic = 2;
  25.     rgbsize = 16;
  26.     Undo = $6100;
  27.     Help = $6200;
  28.     Escape = $011B;
  29.     Tab = $0F09;
  30.     Backspace = $0E08;
  31.     F1 = $3B00;
  32.     F2 = $3C00;
  33.     PicBeg = 1;
  34.     PicEnd = 32256;  { integer array }
  35.  
  36.   TYPE
  37.     modetype = draw .. text;
  38.     drawmodetype = 1 .. 2;
  39.     MFDBtype = PACKED ARRAY [ 1 .. 76 ] OF byte;
  40.     picType = PACKED ARRAY [ PicBeg .. PicEnd ] OF byte ;
  41.     RGBtype = PACKED ARRAY [ 0 .. 15 ] OF 
  42.               PACKED ARRAY [ 1 .. 3  ] OF integer;
  43.     SliderType = RECORD
  44.                   x_inc,y_inc,
  45.                   x_size,y_size,
  46.                   x_limit,y_limit,
  47.                   x_offset,y_offset,
  48.                   x_slide,y_slide,h_slide,v_slide : integer
  49.                  END;
  50.     
  51.   VAR
  52.     ctrl : Ctrl_Parms;
  53.     int_in : Int_In_Parms;
  54.     int_out : Int_Out_Parms;
  55.     pts_in : Pts_In_Parms;
  56.     pts_out : Pts_Out_Parms;
  57.     addr_in : Addr_In_Parms;
  58.     addr_out : Addr_Out_Parms;
  59.  
  60.     title,info : Window_Title;
  61.     msg : Message_Buffer;
  62.     RGB : RGBtype;
  63.     pic : picType;
  64.     deskcolors,sketchcolors : Palette;   
  65.     path : Path_Name;
  66.     c_name : C_String;
  67.     p_name : Str255;
  68.     resource : String[9];
  69.     drawmode : drawmodetype;
  70.     mode : modetype;
  71.     dialog1_ptr,dialog2_ptr : Dialog_Ptr;
  72.     desk_name : Str255;
  73.     mag,wind : SliderType;
  74.     MFDB : MFDBtype;
  75.     picture,pic_start,screen,saturation,coverage,
  76.     oldmouse,newmouse,MFDBptr : long_integer;
  77.     x,y,w,h,
  78.     gzz_x,gzz_y,gzz_w,gzz_h,
  79.     bit_w,bit_h,xmax,ymax,bottomedge,rightedge,
  80.     window,
  81.     bitplanes,byteplanes,nextplane,rowsize,bitsize,aspect,
  82.     paintstyle,XBIOScolor,rez,blitmode,
  83.     dummy,event,
  84.     keystate,key,mx,my,
  85.     Fx,Ox,FOwidth1,FOwidth2,FOxoffset,FOyoffset,
  86.     origx,origy,
  87.     brushwidth,brusheight,textsize,
  88.     radius,palettesize,linestyle,
  89.     inkwellcolor,inkwellspot,inkwell_width,inkwell_height,
  90.     menubar,patternspot,
  91.     ap_id,menu_id : integer;
  92.  
  93.    FUNCTION Addr_Palette( VAR Pal_array : Palette ) : long_integer;
  94.     FUNCTION Addr( VAR Pal_array : Palette ) : long_integer;
  95.      EXTERNAL;
  96.     BEGIN
  97.      Addr_Palette := Addr( Pal_array )
  98.     END;
  99.  
  100.   PROCEDURE Blit( MFDBptr : long_integer );
  101.    C;
  102.  
  103.   FUNCTION InitVec( ymin : integer; oldvec : long_integer ) : long_integer;
  104.    C;
  105.    
  106.   FUNCTION DumVec : long_integer;
  107.    C;
  108.    
  109.   FUNCTION Drive : integer;
  110.    gemdos( $19 );
  111.  
  112.   FUNCTION F_Create( VAR string : C_String;
  113.                      attributes : integer ) : integer;
  114.    gemdos( $3C );        
  115.  
  116.   FUNCTION F_Close( handle : integer ) : integer;
  117.    gemdos( $3E );
  118.  
  119.   FUNCTION F_Read( handle : integer; count  : long_integer;
  120.                    picture : long_integer ) : long_integer;
  121.    gemdos( $3F );
  122.    
  123.   FUNCTION F_Write( handle : integer; count  : long_integer;
  124.                     picture : long_integer ) : long_integer;
  125.    gemdos( $40 );
  126.    
  127.   FUNCTION F_Seek( offset : long_integer;  
  128.                    handle,mode : integer ) : long_integer;
  129.    gemdos( $42 );
  130.    
  131.   PROCEDURE GetDir( VAR path : C_String;  drive : integer );
  132.    gemdos( $47 );
  133.    
  134.   FUNCTION Physbase : long_integer;
  135.    XBIOS( 2 );
  136.  
  137.   FUNCTION Logbase : long_integer;
  138.    XBIOS( 3 );
  139.  
  140.   FUNCTION getrez : integer;
  141.    XBIOS( 4 );
  142.  
  143.   PROCEDURE SetScreen( log,phys : long_integer;  rez : integer );  
  144.    XBIOS( 5 );
  145.  
  146.   PROCEDURE SetPalette( pal_ptr : long_integer );
  147.    XBIOS( 6 );
  148.  
  149.   FUNCTION SetGetColor( coloreg,color : integer ) : integer;
  150.    XBIOS( 7 );
  151.  
  152.   FUNCTION random : long_integer;
  153.    XBIOS( 17 );
  154.  
  155.   PROCEDURE MouseVector( newvector : long_integer; 
  156.                          VAR oldvector : long_integer );
  157.    TYPE
  158.     Ctrl_Parms = RECORD
  159.                   c6,c5,c4,c3,c2,c1,c0 : integer;
  160.                   newvec : long_integer;
  161.                   oldvec : long_integer
  162.                  END;
  163.    VAR
  164.     ctrl : Ctrl_Parms;
  165.     
  166.    PROCEDURE VDI_Call( cmd,sub_cmd,nints,npts : integer;
  167.                        VAR ctrl    : Ctrl_Parms;
  168.                        VAR int_in  : Int_In_Parms;
  169.                        VAR int_out : Int_Out_Parms;
  170.                        VAR pts_in  : Pts_In_Parms;
  171.                        VAR pts_out : Pts_Out_Parms;
  172.                        translate   : boolean );
  173.       EXTERNAL ;
  174.    BEGIN
  175.     ctrl.newvec := newvector;
  176.     VDI_Call( 126,0,0,0,ctrl,int_in,int_out,pts_in,pts_out,FALSE );
  177.     oldvector := ctrl.oldvec
  178.    END;
  179.  
  180.   FUNCTION Pixel( xpos,ypos : integer ) : integer;
  181.    BEGIN
  182.     pts_in[0] := xpos;
  183.     pts_in[1] := ypos;
  184.     VDI_Call( 105,0,0,2,ctrl,int_in,int_out,pts_in,pts_out,FALSE );
  185.     Pixel := int_out[0]
  186.    END;
  187.    
  188.    PROCEDURE Line_Width( size : integer );
  189.     BEGIN
  190.      pts_in[0] := size;
  191.      pts_in[1] := 0;
  192.      VDI_Call( 16,0,0,2,ctrl,int_in,int_out,pts_in,pts_out,FALSE )
  193.     END;
  194.  
  195.   FUNCTION GemToXbios( reg : integer ) : integer;
  196.    BEGIN
  197.     CASE reg OF
  198.      1:
  199.       CASE rez OF
  200.        0: GemToXbios := 15;
  201.        1: GemToXbios := 3;
  202.        2: GemToXbios := reg 
  203.       END;
  204.      2,3,8,9,10,11:
  205.            GemToXbios := reg-1;
  206.      7,15: GemToXbios := reg-2;
  207.      6,14: GemToXbios := reg-3;
  208.      5,13: GemToXbios := reg+1;
  209.      OTHERWISE:
  210.            GemToXbios := reg
  211.     END
  212.    END;
  213.  
  214.   FUNCTION XbiosToGem( reg : integer ) : integer;
  215.    BEGIN
  216.     CASE reg OF
  217.      15:   XbiosToGem := 1;
  218.      1,2,7,8,9,10:
  219.            XbiosToGem := reg+1;
  220.      5,13: XbiosToGem := reg+2;
  221.      3,11:
  222.       IF rez = 1 THEN
  223.        XbiosToGem := 1
  224.       ELSE
  225.        XbiosToGem := reg+3;
  226.      6,14: XbiosToGem := reg-1;
  227.      OTHERWISE:
  228.            XbiosToGem := reg
  229.     END
  230.    END;
  231.  
  232.   PROCEDURE StoreColors;
  233.    CONST
  234.     Red = 1792;  Green = 112;  Blue = 7;
  235.    VAR
  236.     i,col : integer;
  237.    BEGIN
  238.     FOR i := 0 TO 15 DO
  239.      BEGIN
  240.       col := SetGetColor( GemToXbios( i ),-1 );
  241.       RGB[i][1] := ( col & Red   ) DIV 256;
  242.       RGB[i][2] := ( col & Green ) DIV 16;
  243.       RGB[i][3] :=   col & Blue
  244.      END
  245.    END;
  246.  
  247.   PROCEDURE Delay( duration : long_integer );
  248.    BEGIN
  249.     dummy := Get_Event( E_Timer,
  250.                         0,0,0,duration,FALSE,0,0,0,0,FALSE,0,0,0,0,
  251.                         msg,dummy,dummy,dummy,dummy,dummy,dummy )
  252.    END;
  253.  
  254.   PROCEDURE LoadError;
  255.    BEGIN
  256.     dummy :=
  257.      Do_Alert('[3][ | |Load Error!| | ][ Understood ]',1 )
  258.    END;
  259.     
  260.   PROCEDURE SaveError;
  261.    BEGIN
  262.     dummy :=
  263.      Do_Alert('[3][ | |Save Error!| | ][ Understood ]',1 )
  264.    END;
  265.     
  266.   PROCEDURE GetColors( VAR col : Palette );
  267.    VAR
  268.     i : integer;
  269.    BEGIN 
  270.     FOR i := 0 TO 15 DO
  271.      col[i] := SetGetColor( i,-1 )
  272.    END;
  273.    
  274.   PROCEDURE SavePalette;
  275.    BEGIN
  276.     GetColors( sketchcolors );
  277.     StoreColors
  278.    END;
  279.    
  280.   PROCEDURE ClipWindow( VAR xpos,ypos,width,height : integer );
  281.    BEGIN
  282.     Work_Rect( window,xpos,ypos,width,height );
  283.     gzz_x := xpos;
  284.     gzz_y := ypos+inkwell_height+3;
  285.     gzz_w := width;
  286.     gzz_h := height-inkwell_height-3;
  287.     rightedge := gzz_x+gzz_w-1;
  288.     bottomedge := gzz_y+gzz_h-1;
  289.     Fx := rightedge-FOwidth2+1;
  290.     Ox := rightedge-FOwidth1+1;
  291.     inkwellspot := xpos+( inkwellcolor*inkwell_width );
  292.     WITH wind DO
  293.      BEGIN
  294.       x_size  := SHORT_TRUNC(( gzz_w / xmax ) * 1000 );
  295.       y_size  := SHORT_TRUNC(( gzz_h / ymax ) * 1000 );
  296.       x_limit := ( xmax-gzz_w )+1;
  297.       y_limit := ( ymax-gzz_h )+1;
  298.       x_slide := SHORT_TRUNC( 1000 / x_limit ) * x_inc; 
  299.       y_slide := SHORT_TRUNC( 1000 / y_limit ) * y_inc
  300.      END;
  301.     Set_Clip( gzz_x,gzz_y,gzz_w,gzz_h )
  302.    END; 
  303.    
  304.   FUNCTION Click( mask : integer ) : boolean;
  305.    BEGIN
  306.     AES_Call( mousestate,int_in,int_out,addr_in,addr_out );
  307.     Click := int_out[3] & mask <> 0
  308.    END;
  309.    
  310.   FUNCTION ButtonDown( VAR newx,newy : integer ) : boolean;
  311.    BEGIN
  312.     event := Get_Event( E_Message | E_Button | E_Timer,
  313.                         1,1,1,0,FALSE,0,0,0,0,FALSE,0,0,0,0,
  314.                         msg,dummy,dummy,dummy,newx,newy,dummy );
  315.     ButtonDown := event & E_Button <> 0                   
  316.    END;
  317.  
  318.   PROCEDURE Limit( VAR position : integer;  min,max : integer );
  319.    BEGIN
  320.     IF position < min THEN  position := min;
  321.     IF position > max THEN  position := max
  322.    END;
  323.    
  324.   PROCEDURE RubberBox( keystate,mx,my,xmin,ymin,xmax,ymax : integer;
  325.                        VAR width,height : integer );
  326.    VAR
  327.     newx,newy : integer;
  328.    BEGIN
  329.     Hide_Mouse;
  330.     Draw_Mode( 3 );
  331.     Line_Color( 1 );
  332.     Line_Style( 1 );
  333.     IF ( mode = box ) OR ( mode = block ) THEN  Line_Width( 1 );
  334.     WHILE ButtonDown( newx,newy ) DO
  335.      BEGIN
  336.       Limit( newx,xmin,xmax );
  337.       Limit( newy,ymin,ymax );
  338.       width := ABS( newx-mx );
  339.       IF keystate & shiftkeys <> 0 THEN
  340.        height := width DIV aspect
  341.       ELSE
  342.        height := ABS( newy-my ); 
  343.       Frame_Rect( mx,my,width,height );
  344.       Delay( 25 );
  345.       Frame_Rect( mx,my,width,height )
  346.      END
  347.    END;
  348.  
  349. PROCEDURE ModeInfo;
  350.  BEGIN
  351.   CASE mode OF
  352.    draw:
  353.     info := ' DRAW';
  354.    magnify:
  355.     info := ' MAGNIFY';
  356.    circle:
  357.     info := ' CIRCLE';
  358.    disc:
  359.     info := ' DISC';
  360.    frame:
  361.     info := ' FRAME';
  362.    box:
  363.     info := ' BOX';
  364.    airbrush:
  365.     info := ' AIRBRUSH';
  366.    lines:
  367.     info := ' LINE';
  368.    block:
  369.     info := ' COPY';
  370.    pal:
  371.     info := ' PALETTE';
  372.    fill:
  373.     info := ' FILL';
  374.    text:
  375.     info := ' TEXT' 
  376.   END
  377.  END;
  378.  
  379.  PROCEDURE ChangeInfo;
  380.   BEGIN
  381.    info := '';
  382.    Set_Winfo( window,info );
  383.    ModeInfo;
  384.    Set_Winfo( window,info )
  385.   END;
  386.  
  387.   PROCEDURE Attributes;
  388.    BEGIN
  389.     Paint_Style( paintstyle );
  390.     Paint_Color( XBIOScolor );
  391.     Line_Color( XBIOScolor );
  392.     Line_Style( linestyle );
  393.     Line_Width( brushwidth );
  394.     Draw_Mode( drawmode );
  395.     Text_Color( XBIOScolor );
  396.     Text_Style( Normal );
  397.     Text_Height( textsize )
  398.    END;
  399.   
  400.   PROCEDURE CopyRaster( source,destination : long_integer;
  401.                         src_xorigin,src_yorigin,dest_xorigin,dest_yorigin,
  402.                         dest_x,dest_y,width,height,mode : integer );
  403.  
  404.    PROCEDURE DoBlit( src_ptr,dest_ptr : long_integer;
  405.                      src_x,src_y,s_nextplane,d_nextplane,copymode :integer);
  406.     BEGIN
  407.      WPOKE( MFDBptr,width );
  408.      WPOKE( MFDBptr+2,height );
  409.      WPOKE( MFDBptr+4,bitplanes );
  410.      POKE( MFDBptr+10,copymode );
  411.      POKE( MFDBptr+11,copymode );
  412.      POKE( MFDBptr+12,copymode );
  413.      POKE( MFDBptr+13,copymode );
  414.      WPOKE( MFDBptr+14,src_x );
  415.      WPOKE( MFDBptr+16,src_y );
  416.      LPOKE( MFDBptr+18,src_ptr );
  417.      WPOKE( MFDBptr+26,s_nextplane );
  418.      WPOKE( MFDBptr+28,dest_x );
  419.      WPOKE( MFDBptr+30,dest_y );
  420.      LPOKE( MFDBptr+32,dest_ptr );
  421.      WPOKE( MFDBptr+40,d_nextplane );
  422.      Blit( MFDBptr )
  423.     END;
  424.     
  425.    BEGIN
  426.     Hide_Mouse;
  427.     IF mode = 7 THEN
  428.      BEGIN
  429.       { 1. Clear dest
  430.         2. Combine source and dest into one plane
  431.         3. Unroll dest into multiple planes
  432.         4. Source AND ( NOT dest )                  }
  433.       DoBlit( source,destination,src_xorigin,src_yorigin,
  434.               nextplane,nextplane,0 );
  435.       DoBlit( source,destination,src_xorigin,src_yorigin,nextplane,0,7 );
  436.       DoBlit( destination,destination,dest_x,dest_y,0,nextplane,7 );
  437.       DoBlit( source,destination,dest_xorigin,dest_yorigin,
  438.               nextplane,nextplane,2 )
  439.      END;
  440.     DoBlit( source,destination,src_xorigin,src_yorigin,
  441.             nextplane,nextplane,mode );
  442.     Show_Mouse
  443.    END;
  444.   
  445.   PROCEDURE Blit_to_Screen;
  446.    BEGIN
  447.     screen := Physbase;
  448.     CASE mode OF
  449.      magnify,pal:  ;
  450.      OTHERWISE:
  451.       CopyRaster( picture,screen,wind.x_offset,wind.y_offset,0,0,
  452.                   gzz_x,gzz_y,gzz_w,gzz_h,3 )
  453.     END
  454.    END;
  455.       
  456.   PROCEDURE Blit_to_Memory;
  457.    BEGIN
  458.     screen := Physbase;
  459.     CASE mode OF
  460.      magnify:  ;
  461.      pal:
  462.       SavePalette;
  463.      OTHERWISE:
  464.       CopyRaster( screen,picture,gzz_x,gzz_y,0,0,
  465.                   wind.x_offset,wind.y_offset,gzz_w,gzz_h,3 )
  466.     END
  467.    END;
  468.  
  469.   PROCEDURE ClearPic;
  470.    VAR
  471.     i : integer;
  472.    BEGIN
  473.     FOR i := PicBeg TO PicEnd DO
  474.      pic[i] := 0
  475.    END;
  476.    
  477.   PROCEDURE SetVariables;
  478.    VAR
  479.     i : integer;
  480.  
  481.    FUNCTION Addr_Pic( VAR Screen_pic : picType ) : long_integer;
  482.     FUNCTION Addr( VAR Screen_pic : picType ) : long_integer;
  483.      EXTERNAL;
  484.     BEGIN
  485.      Addr_Pic := Addr( Screen_pic )
  486.     END;
  487.    
  488.    FUNCTION Addr_MFDB( VAR MFDB : MFDBtype ) : long_integer;
  489.     FUNCTION Addr( VAR MFDB : MFDBtype ) : long_integer;
  490.      EXTERNAL;
  491.     BEGIN
  492.      Addr_MFDB := Addr( MFDB )
  493.     END;
  494.  
  495.    BEGIN
  496.     inkwellcolor := 1;
  497.     XBIOScolor := XbiosToGem( inkwellcolor );
  498.     paintstyle := 1;
  499.     linestyle := 1;
  500.     brushwidth := 1;
  501.     textsize := 3;
  502.     bitsize := 5;
  503.     patternspot := ( inkwell_width*palettesize )+1;
  504.     drawmode := transparent_mode;
  505.     blitmode := 7;
  506.     mode := draw;
  507.     saturation := 35;
  508.     coverage := 15;
  509.     pic_start := Addr_Pic( pic );
  510.     MFDBptr := Addr_MFDB( MFDB );
  511.     picture := (( pic_start DIV 256 ) * 256 ) + 256;
  512.     GetDir( c_name,Drive );
  513.     C_TO_PSTR( c_name,p_name );
  514.     path := CONCAT( CHR( $41+Drive ),':',p_name,'\*.*' ); 
  515.     p_name := '';
  516.     WPOKE( MFDBptr+6,1 );
  517.     WPOKE( MFDBptr+8,0 );
  518.     WPOKE( MFDBptr+22,byteplanes );
  519.     WPOKE( MFDBptr+24,rowsize );
  520.     WPOKE( MFDBptr+36,byteplanes );
  521.     WPOKE( MFDBptr+38,rowsize );
  522.     LPOKE( MFDBptr+42,0 );
  523.     WPOKE( MFDBptr+46,0 );
  524.     WPOKE( MFDBptr+48,0 );
  525.     WPOKE( MFDBptr+50,0 );
  526.     FOR i := 52 TO 75 DO
  527.      POKE( MFDBptr+i,0 );
  528.     WITH wind DO
  529.      BEGIN
  530.       h_slide := 1;
  531.       v_slide := 1;
  532.       x_offset := 0;
  533.       y_offset := 0;
  534.       x_inc := 8;
  535.       y_inc := 10;
  536.       x_size := -1;
  537.       y_size := -1
  538.      END;
  539.     mag := wind;
  540.     mag.x_inc := 1;
  541.     mag.y_inc := 1
  542.   END;
  543.  
  544.   PROCEDURE GetResolution;
  545.    BEGIN
  546.     rez := getrez;
  547.     CASE rez OF
  548.      0:                    { low-res }
  549.       BEGIN
  550.        xmax := 319;
  551.        ymax := 199;
  552.        menubar := 12;
  553.        bitplanes := 4;
  554.        nextplane := 2;
  555.        aspect := 1;
  556.        rowsize := 160;
  557.        palettesize := 16;
  558.        FOwidth1 := 19;
  559.        FOwidth2 := 38;
  560.        FOxoffset := 1;
  561.        FOyoffset := 17;
  562.        inkwell_width := 12;
  563.        inkwell_height := 20
  564.       END;
  565.  
  566.      1:                    { medium-res }
  567.       BEGIN
  568.        xmax := 639;
  569.        ymax := 199;
  570.        menubar := 12;
  571.        bitplanes := 2;
  572.        nextplane := 2;
  573.        aspect := 2;
  574.        rowsize := 160;
  575.        palettesize := 4;
  576.        FOwidth1 := 34;
  577.        FOwidth2 := 68;
  578.        FOxoffset := 8;
  579.        FOyoffset := 17;
  580.        inkwell_width := 64;
  581.        inkwell_height := 20
  582.       END;
  583.  
  584.      2:    
  585.       BEGIN               { high-res }
  586.        xmax := 639;
  587.        ymax := 399;
  588.        menubar := 20;
  589.        bitplanes := 1;
  590.        nextplane := 0;
  591.        aspect := 1;
  592.        rowsize := 80;
  593.        palettesize := 2;
  594.        FOwidth1 := 34;
  595.        FOwidth2 := 68;
  596.        FOxoffset := 8;
  597.        FOyoffset := 32;
  598.        inkwell_width := 128;
  599.        inkwell_height := 40
  600.       END
  601.     END;
  602.     byteplanes := bitplanes * 2
  603.   END;
  604.   
  605.   PROCEDURE Initialize;
  606.    BEGIN
  607.     GetResolution;
  608.     SetVariables;
  609.     GetColors( deskcolors );
  610.     SavePalette;
  611.     ClearPic;
  612.     title := ' MultiPaint ';
  613.     IO_Check( FALSE );
  614.     Attributes
  615.    END;
  616.  
  617.   PROCEDURE DrawPatternBox;
  618.    BEGIN
  619.     Paint_Outline( TRUE );
  620.     Paint_Color( 1 );
  621.     Paint_Style( paintstyle );
  622.     Draw_Mode( 1 );
  623.     Paint_Rect( x+patternspot,y+1,w-patternspot-FOwidth2-1,inkwell_height )
  624.    END;
  625.  
  626.   PROCEDURE ClearWindow;
  627.    BEGIN
  628.     Hide_Mouse;
  629.     Paint_Color( 0 );
  630.     Paint_Style( 1 );
  631.     Paint_Rect( x,y,w,h );
  632.     Attributes;
  633.     Show_Mouse
  634.    END;
  635.  
  636.   PROCEDURE DoPaint( xpos,ypos : integer );
  637.    BEGIN
  638.     Hide_Mouse;
  639.     int_in[0] := -1;
  640.     pts_in[0] := xpos;
  641.     pts_in[1] := ypos;
  642.     VDI_Call( 103,0,1,2,ctrl,int_in,int_out,pts_in,pts_out,FALSE );
  643.     Show_Mouse
  644.    END;
  645.  
  646.   PROCEDURE FatBits;
  647.    VAR
  648.     i,j,row_pos,row,fatsize : integer;
  649.     log : long_integer;
  650.    BEGIN
  651.     Paint_Outline( TRUE );
  652.     Paint_Style( 1 );
  653.     Line_Color( 1 );
  654.     Line_Style( 1 );
  655.     Line_Width( 1 );
  656.     log := Logbase;
  657.     fatsize := bitsize-1;
  658.     Hide_Mouse;
  659.     info := ' Wait ...';
  660.     Set_Winfo( window,info );
  661.     Frame_Rect( gzz_x-1,gzz_y-1,
  662.               ( bitsize*( bit_w+1 ))+1,( bitsize*( bit_h+1 ))+1 );
  663.     WITH mag DO
  664.      BEGIN
  665.       FOR j := 0 TO bit_h DO
  666.        BEGIN
  667.         row := y_offset+j;
  668.         row_pos := gzz_y+( j*bitsize );
  669.         FOR i := 0 TO bit_w DO
  670.          BEGIN
  671.           SetScreen( picture,-1,-1 );
  672.           IF Pixel( x_offset+i,row ) <> 0 THEN
  673.            BEGIN
  674.             Paint_Color( int_out[1] );
  675.             SetScreen( log,-1,-1 );
  676.             Paint_Rect( gzz_x+( i*bitsize ),row_pos,fatsize,fatsize )
  677.            END
  678.          END
  679.        END
  680.      END;
  681.     SetScreen( log,-1,-1 );
  682.     ChangeInfo;
  683.     Show_Mouse;
  684.     Attributes
  685.    END; 
  686.  
  687.   PROCEDURE ColorPanel;
  688.    CONST
  689.     RGBcenter = 12;
  690.    VAR
  691.     RGBchar : ARRAY [ 1 .. 3 ] OF char;
  692.     i,j,intensity,xpos,ypos,left,right : integer;
  693.    BEGIN
  694.     Hide_Mouse;
  695.     Text_Color( 1 );
  696.     Line_Color( 1 );
  697.     Paint_Color( 1 );
  698.     Line_Style( 1 );
  699.     Line_Width( 1 );
  700.     Paint_Style( 1 );
  701.     Text_Style( Normal );
  702.     Text_Height( 8 );
  703.     Paint_Outline( TRUE );
  704.     RGBchar[1] := 'R';
  705.     RGBchar[2] := 'G';
  706.     RGBchar[3] := 'B';
  707.     left := gzz_x+( rgbsize DIV 4 );
  708.     right := left+( rgbsize * 9 );
  709.     FOR j := 1 TO 3 DO
  710.      BEGIN
  711.       ypos := gzz_y+(( j-1 )*rgbsize );
  712.       intensity := RGB[XBIOScolor][j]+1;
  713.       FOR i := 0 TO 9 DO
  714.        BEGIN
  715.         xpos := gzz_x+( i*rgbsize );
  716.         IF intensity = i THEN
  717.          Paint_Rect( xpos,ypos,rgbsize,rgbsize )
  718.         ELSE
  719.          Frame_Rect( xpos,ypos,rgbsize,rgbsize )
  720.        END;
  721.       ypos := ypos+RGBcenter;
  722.       Draw_String( left,ypos,RGBchar[j] );      
  723.       Draw_String( right,ypos,RGBchar[j] );
  724.      END;
  725.     Attributes;
  726.     Show_Mouse
  727.    END;
  728.  
  729.   PROCEDURE DrawScreen;
  730.    VAR
  731.     i,ypos : integer;
  732.    BEGIN
  733.     ClearWindow;
  734.     Paint_Style( 1 );
  735.     Line_Color( 1 );
  736.     Line_Style( 1 );
  737.     Line_Width( 1 );
  738.     Text_Color( 1 );
  739.     Text_Style( Outlined );
  740.     IF rez = 2 THEN
  741.      Text_Height( 26 )
  742.     ELSE
  743.      Text_Height( 12 );
  744.     FOR i := 1 TO palettesize-1 DO
  745.      BEGIN
  746.       Paint_Color( XbiosToGem( i ));
  747.       Paint_Rect( x+( i*inkwell_width ),y+1,inkwell_width,inkwell_height )
  748.      END;
  749.     Frame_Rect( x,y+1,inkwell_width,inkwell_height );
  750.     Frame_Rect( inkwellspot,y,inkwell_width,inkwell_height+2 );
  751.     ypos := gzz_y-1;
  752.     Line( gzz_x,ypos,gzz_x+gzz_w,ypos );
  753.     Draw_Mode( 2 );
  754.     Frame_Rect( Fx,y+1,FOwidth1-1,inkwell_height );
  755.     Frame_Rect( Ox,y+1,FOwidth1-1,inkwell_height );
  756.     Draw_String( Fx+FOxoffset,y+FOyoffset,'F' );
  757.     Draw_String( Ox+FOxoffset,y+FOyoffset,'O' );
  758.     DrawPatternBox;
  759.     Attributes;
  760.     CASE mode OF
  761.      magnify:   FatBits;
  762.      pal:       ColorPanel;
  763.      OTHERWISE: Blit_to_Screen
  764.     END
  765.    END;
  766.    
  767.   PROCEDURE Redraw;
  768.    BEGIN
  769.     Begin_Update;
  770.     Hide_Mouse;
  771.     Set_Clip( x,y,w,h );
  772.     DrawScreen;
  773.     Set_Clip( gzz_x,gzz_y,gzz_w,gzz_h );
  774.     Show_Mouse;
  775.     End_Update
  776.    END;
  777.  
  778.  FUNCTION Slider( slide,limit,WF_Flag : integer ) : integer;
  779.   BEGIN
  780.    Slider := SHORT_TRUNC(( slide / 1000 ) * limit );
  781.    Wind_Set( window,WF_Flag,slide,0,0,0 )
  782.   END;
  783.  
  784.  PROCEDURE ScrollBars;
  785.  
  786.   PROCEDURE SetSliders( h_slide,v_slide,x_size,y_size : integer );
  787.    BEGIN
  788.     Wind_Set( window,WF_HSlide,h_slide,0,0,0 );
  789.     Wind_Set( window,WF_VSlide,v_slide,0,0,0 );
  790.     Wind_Set( window,WF_HSlSize,x_size,0,0,0 );
  791.     Wind_Set( window,WF_VSlSize,y_size,0,0,0 )
  792.    END;
  793.    
  794.   BEGIN
  795.    CASE mode OF
  796.     magnify:
  797.      WITH mag DO
  798.       BEGIN
  799.        bit_w := ( gzz_w DIV bitsize )-1;
  800.        bit_h := ( gzz_h DIV bitsize )-1;
  801.        x_limit := xmax-bit_w;
  802.        y_limit := ymax-bit_h;
  803.        x_slide := SHORT_ROUND( 1000 / ( x_limit+1 )); 
  804.        y_slide := SHORT_ROUND( 1000 / ( y_limit+1 ));
  805.        x_offset := Slider( h_slide,x_limit,WF_HSlide );
  806.        y_offset := Slider( v_slide,y_limit,WF_VSlide );
  807.        SetSliders( h_slide,v_slide,x_size,y_size )
  808.       END;
  809.     pal:  ;
  810.     OTHERWISE:
  811.      WITH wind DO
  812.       SetSliders( h_slide,v_slide,x_size,y_size )
  813.    END
  814.   END;
  815.  
  816.  FUNCTION EventMulti : integer;
  817.   BEGIN
  818.    EventMulti := Get_Event( E_Message | E_Keyboard | E_Button |
  819.                             E_Timer | E_MRect_1,
  820.                             1,1,1,0,FALSE,x,y,w,h,TRUE,0,0,0,0,
  821.                             msg,key,dummy,dummy,mx,my,keystate )
  822.   END;
  823.  
  824.  PROCEDURE BlockCopy( keystate,xpos,ypos : integer );
  825.   VAR
  826.    key,origx,origy,newx,newy,width,height,xorigin,yorigin : integer;
  827.    Move : boolean;
  828.  
  829.   PROCEDURE TrapBlit( VAR xpos,ypos : integer );
  830.    BEGIN
  831.     Limit( xpos,gzz_x,rightedge-width+1 );
  832.     Limit( ypos,gzz_y,bottomedge-height+1 );
  833.    END;
  834.  
  835.   PROCEDURE BlitToOrigin;
  836.    BEGIN
  837.     CopyRaster( picture,screen,
  838.                 xorigin,yorigin,0,0,origx,origy,width,height,6 )
  839.    END;
  840.  
  841.   PROCEDURE BlitToMouse( mode : integer );
  842.    BEGIN
  843.     CopyRaster( picture,screen,xorigin,yorigin,
  844.                 wind.x_offset+newx-gzz_x,wind.y_offset+newy-gzz_y,
  845.                 newx,newy,width,height,mode )
  846.    END;
  847.    
  848.   BEGIN
  849.    Blit_to_Memory;
  850.    Limit( xpos,gzz_x+1,rightedge+1 );
  851.    Limit( ypos,gzz_y+1,bottomedge+1 );
  852.    RubberBox( keystate,xpos,ypos,
  853.               gzz_x+1,gzz_y+1,rightedge+1,bottomedge+1,width,height );
  854.    Limit( width,8,rightedge-xpos+1 );
  855.    Limit( height,8,bottomedge-ypos+1 );
  856.    xorigin := wind.x_offset+xpos-gzz_x;
  857.    yorigin := wind.y_offset+ypos-gzz_y;
  858.    origx := xpos;
  859.    origy := ypos;
  860.    Move := keystate & alternate <> 0;
  861.    IF Move THEN
  862.     CopyRaster( picture,screen,
  863.                 xorigin,yorigin,0,0,origx,origy,width,height,0 );
  864.    TrapBlit( origx,origy );
  865.    BlitToOrigin;                        { Xor }
  866.    Begin_Mouse;
  867.    LOOP
  868.     EXIT IF ButtonDown( newx,newy ) OR Click( rightbutton );
  869.     TrapBlit( newx,newy );
  870.     IF ( origx <> newx ) OR ( origy <> newy ) THEN
  871.      BEGIN
  872.       BlitToOrigin;                    { Xor }
  873.       BlitToMouse( 6 );
  874.       origx := newx;
  875.       origy := newy
  876.      END
  877.    END;
  878.    TrapBlit( newx,newy );
  879.    BlitToOrigin;
  880.    IF Click( rightbutton ) THEN        { 'Brush' function }
  881.     WHILE Click( rightbutton ) DO
  882.      BEGIN
  883.       newx := int_out[1];
  884.       newy := int_out[2];
  885.       TrapBlit( newx,newy );
  886.       BlitToMouse( 3 )
  887.      END
  888.    ELSE 
  889.     BEGIN
  890.      IF Move THEN
  891.       BlitToMouse( 3 )
  892.      ELSE
  893.       BlitToMouse( blitmode );
  894.      WHILE Click( leftbutton ) DO  ;
  895.     END;
  896.    End_Mouse;
  897.    Attributes;
  898.    Show_Mouse
  899.   END;
  900.  
  901.  PROCEDURE TrapMouse;
  902.   VAR
  903.    dummy : long_integer;
  904.   BEGIN
  905.    newmouse := DumVec;
  906.    MouseVector( newmouse,oldmouse );
  907.    newmouse := InitVec( menubar,oldmouse );
  908.    MouseVector( newmouse,dummy )
  909.   END;
  910.      
  911.  PROCEDURE SketchOn;
  912.   BEGIN
  913.    IF window = No_window THEN
  914.     BEGIN
  915.      TrapMouse;
  916.      GetColors( deskcolors );
  917.      IF keystate & alternate = 0 THEN
  918.       SetPalette( Addr_Palette( sketchcolors ))
  919.      ELSE
  920.       SavePalette;
  921.      window := New_Window( G_Name    | G_Info    | G_Close  |
  922.                            G_UpArrow | G_DnArrow | G_VSlide |
  923.                            G_LArrow  | G_RArrow  | G_HSlide,title,0,0,0,0 );
  924.      Open_window( window,0,0,0,0 );
  925.      Border_Rect( window,x,y,w,h );
  926.      ClipWindow( x,y,w,h );
  927.      ScrollBars;
  928.      ChangeInfo;
  929.     END
  930.   END;
  931.  
  932. PROCEDURE SketchOff;
  933.  VAR
  934.   current_window : integer;
  935.   dummy : long_integer;
  936.  BEGIN
  937.   Blit_to_Memory;
  938.   IF keystate & alternate = 0 THEN
  939.    SetPalette( Addr_Palette( deskcolors ));
  940.   Close_Window( window );
  941.   Delete_Window( window );
  942.   window := No_Window;
  943.   MouseVector( oldmouse,dummy )
  944.  END;
  945.  
  946. PROCEDURE Perimeter( keystate : integer );
  947.  BEGIN
  948.   IF keystate & control <> 0 THEN
  949.    Paint_OutLine( TRUE )
  950.   ELSE
  951.    Paint_Outline( FALSE )
  952.  END;
  953.  
  954. PROCEDURE DoMagnify( mx,my : integer );
  955.  VAR
  956.   xpix,ypix : integer;
  957.   log : long_integer;
  958.  BEGIN
  959.   xpix := ( mx-gzz_x ) DIV bitsize;
  960.   ypix := ( my-gzz_y ) DIV bitsize;
  961.   IF ( xpix <= bit_w ) AND ( ypix <= bit_h ) THEN
  962.    BEGIN
  963.     Paint_OutLine( TRUE );
  964.     Paint_Style( 1 );
  965.     Line_Style( 1 );
  966.     Line_Width( 1 );
  967.     Hide_Mouse;
  968.     Paint_Rect( gzz_x+( xpix * bitsize ),gzz_y+( ypix * bitsize ),
  969.                 bitsize-1,bitsize-1 );
  970.     Show_Mouse;
  971.     log := Logbase;
  972.     SetScreen( picture,-1,-1 );
  973.     Set_Clip( 0,0,xmax+1,ymax+1 );
  974.     Plot( mag.x_offset+xpix,mag.y_offset+ypix );   
  975.     Set_Clip( gzz_x,gzz_y,gzz_w,gzz_h );
  976.     SetScreen( log,-1,-1 );
  977.     Attributes
  978.    END
  979.  END;
  980.  
  981. PROCEDURE DoAirbrush;
  982.  VAR
  983.   newx,newy : integer;
  984.   
  985.  PROCEDURE FindSpot;
  986.   BEGIN
  987.    newx := newx+( SHR( random,5 ) & coverage );
  988.    Delay( saturation );
  989.    newy := newy+( SHR( random,5 ) & coverage )
  990.   END;
  991.  
  992.  BEGIN
  993.   Hide_Mouse;
  994.   Line_Width( 1 );
  995.   Paint_Outline( FALSE );
  996.   IF brushwidth > 1 THEN
  997.    WHILE ButtonDown( newx,newy ) DO
  998.     BEGIN
  999.      FindSpot;
  1000.      Paint_Rect( newx,newy,brushwidth,brusheight )
  1001.     END
  1002.   ELSE 
  1003.    WHILE ButtonDown( newx,newy ) DO
  1004.     BEGIN
  1005.      FindSpot;
  1006.      Plot( newx,newy )
  1007.     END;
  1008.   Attributes;
  1009.   Show_Mouse
  1010.  END;
  1011.  
  1012. PROCEDURE DoLine( keystate,mx,my : integer );
  1013.  VAR
  1014.   newx,newy : integer;
  1015.  
  1016.  PROCEDURE OriginAt( xpos,ypos : integer );
  1017.   BEGIN
  1018.    origx := xpos;
  1019.    origy := ypos
  1020.   END;
  1021.  
  1022.  BEGIN
  1023.   IF keystate & control <> 0 THEN          { establish starting point }
  1024.    BEGIN
  1025.     Set_Mouse( M_Thin_Cross );
  1026.     WHILE Click( leftbutton ) DO  ;
  1027.     OriginAt( int_out[1],int_out[2] );
  1028.     Set_Mouse( M_Arrow )
  1029.    END
  1030.   ELSE
  1031.    BEGIN
  1032.     Hide_Mouse;
  1033.     IF keystate & shiftkeys <> 0 THEN      { Rays }
  1034.      Line( origx,origy,mx,my )
  1035.     ELSE
  1036.      BEGIN                                 { Lines }
  1037.       Draw_Mode( 3 );
  1038.       IF keystate & alternate = 0 THEN     { no Kline }
  1039.        OriginAt( mx,my );
  1040.       WHILE ButtonDown( newx,newy ) DO
  1041.        BEGIN
  1042.         Line( origx,origy,newx,newy );
  1043.         Delay( 25 );
  1044.         Line( origx,origy,newx,newy )
  1045.        END;
  1046.       Draw_Mode( drawmode );
  1047.       Line( origx,origy,newx,newy );
  1048.       OriginAt( newx,newy )
  1049.      END;
  1050.     Show_Mouse
  1051.    END
  1052.  END;
  1053.  
  1054. PROCEDURE DoBox( keystate,mx,my : integer );
  1055.  VAR
  1056.   bwidth,bheight : integer;
  1057.  BEGIN
  1058.   RubberBox( keystate,mx,my,0,0,xmax,ymax,bwidth,bheight );
  1059.   Attributes;
  1060.   IF mode = box THEN
  1061.    BEGIN
  1062.     Perimeter( keystate );
  1063.     IF keystate & alternate <> 0 THEN
  1064.      Paint_Round_Rect( mx,my,bwidth,bheight )
  1065.     ELSE
  1066.      Paint_Rect( mx,my,bwidth,bheight )
  1067.    END
  1068.   ELSE
  1069.    IF keystate & alternate <> 0 THEN
  1070.     Frame_Round_Rect( mx,my,bwidth,bheight )
  1071.    ELSE
  1072.     Frame_Rect( mx,my,bwidth,bheight );
  1073.   Show_Mouse
  1074.  END;
  1075.  
  1076. PROCEDURE DoCircle( keystate,mx,my : integer );
  1077.  VAR
  1078.   xradius,yradius,newx,newy : integer;
  1079.  BEGIN
  1080.   Draw_Mode( 3 );
  1081.   IF mode = disc THEN  Line_Width( 1 );
  1082.   Hide_Mouse;
  1083.   WHILE ButtonDown( newx,newy ) DO
  1084.    BEGIN
  1085.     xradius := ABS( newx-mx );
  1086.     IF keystate & shiftkeys <> 0 THEN
  1087.      yradius := xradius DIV aspect
  1088.     ELSE
  1089.      yradius := ABS( newy-my );
  1090.     Frame_Oval( mx,my,xradius,yradius );
  1091.     Frame_Oval( mx,my,xradius,yradius )
  1092.    END;
  1093.   Attributes;
  1094.   IF mode = disc THEN
  1095.    BEGIN
  1096.     Perimeter( keystate );
  1097.     Paint_Oval( mx,my,xradius,yradius )
  1098.    END
  1099.   ELSE
  1100.    Frame_Oval( mx,my,xradius,yradius );
  1101.   Show_Mouse
  1102.  END;
  1103.  
  1104. PROCEDURE DoDraw( keystate,mx,my : integer );
  1105.  VAR
  1106.   newx,newy : integer;
  1107.   
  1108.  PROCEDURE Point;
  1109.   BEGIN
  1110.    Hide_Mouse;
  1111.    Plot( mx,my );
  1112.    Show_Mouse
  1113.   END;
  1114.  
  1115.  BEGIN
  1116.   Paint_OutLine( TRUE );
  1117.   Line_Style( 1 );
  1118.   Line_Width( 1 );
  1119.   IF brushwidth = 1 THEN
  1120.    CASE keystate & ShiftAlt OF
  1121.     alternate:
  1122.      Point;
  1123.     leftshift,rightshift:
  1124.      BEGIN
  1125.       Point;
  1126.       WHILE Click( leftbutton ) DO  ;
  1127.      END;
  1128.     OTHERWISE:
  1129.      WHILE ButtonDown( newx,newy ) DO
  1130.       BEGIN
  1131.        Hide_Mouse;
  1132.        Line( mx,my,newx,newy );
  1133.        Show_Mouse;
  1134.        mx := newx;
  1135.        my := newy
  1136.       END
  1137.    END
  1138.   ELSE
  1139.    BEGIN
  1140.     Hide_Mouse;
  1141.     Paint_OutLine( FALSE );
  1142.     CASE keystate & ShiftAlt OF
  1143.      alternate:
  1144.       Paint_Rect( mx,my,brushwidth,brusheight );
  1145.      leftshift,rightshift:
  1146.       BEGIN
  1147.        Paint_Rect( mx,my,brushwidth,brusheight );
  1148.        WHILE Click( leftbutton ) DO  ;
  1149.       END;
  1150.      OTHERWISE:
  1151.       WHILE ButtonDown( newx,newy ) DO
  1152.        Paint_Rect( newx,newy,brushwidth,brusheight )
  1153.     END;
  1154.     Show_Mouse
  1155.    END;
  1156.   Attributes
  1157.  END;
  1158.  
  1159. PROCEDURE SetColor( mx : integer );
  1160.  VAR
  1161.   frame_size,inkwell_y : integer;
  1162.  BEGIN
  1163.   Hide_Mouse;
  1164.   Set_Clip( x,y,w,h );
  1165.   frame_size := inkwell_height+2;
  1166.   inkwell_y := y+1;
  1167.   Paint_Style( 1 );
  1168.   Line_Color( 1 );
  1169.   Line_Style( 1 );
  1170.   Line_Width( 1 );
  1171.   Paint_Outline( FALSE );
  1172.   Paint_Color( 0 );
  1173.   Paint_Rect( inkwellspot,y,inkwell_width,frame_size );
  1174.   Paint_Color ( XBIOScolor );
  1175.   IF XBIOScolor = 0 THEN
  1176.    Frame_Rect( inkwellspot,inkwell_y,inkwell_width,inkwell_height )
  1177.   ELSE
  1178.    Paint_Rect( inkwellspot,inkwell_y,inkwell_width,inkwell_height );
  1179.   inkwellcolor := ( mx-x ) DIV inkwell_width;
  1180.   XBIOScolor := XbiosToGem( inkwellcolor );
  1181.   inkwellspot := x+( inkwellcolor*inkwell_width );
  1182.   Frame_Rect( inkwellspot,y,inkwell_width,frame_size );
  1183.   Show_Mouse;
  1184.   Set_Clip( gzz_x,gzz_y,gzz_w,gzz_h );
  1185.   Attributes;
  1186.   IF mode = pal THEN
  1187.    BEGIN
  1188.     ClearWindow;
  1189.     ColorPanel
  1190.    END
  1191.  END;
  1192.  
  1193. PROCEDURE SetPattern( keystate : integer );
  1194.  BEGIN
  1195.   CASE keystate OF
  1196.    control:    paintstyle := 1;            { solid }
  1197.    leftshift,
  1198.    rightshift: paintstyle := 26;           { dither patterns }
  1199.    alternate:  paintstyle := paintstyle-1;
  1200.    OTHERWISE:  paintstyle := paintstyle+1
  1201.   END;
  1202.   IF paintstyle > 37 THEN
  1203.    paintstyle := 0;
  1204.   IF paintstyle < 0  THEN
  1205.    paintstyle := 37;
  1206.   Hide_Mouse;
  1207.   Set_Clip( x,y,w,h );
  1208.   DrawPatternBox;
  1209.   Attributes;
  1210.   Set_Clip( gzz_x,gzz_y,gzz_w,gzz_h );
  1211.   Show_Mouse;
  1212.   Delay( 100 )
  1213.  END;
  1214.  
  1215. PROCEDURE SetRGB( mx,my : integer );
  1216.  VAR
  1217.   i,intensity,gun : integer;
  1218.   
  1219.  PROCEDURE MoveBox( VAR old_intensity : integer; new_intensity : integer );
  1220.   VAR
  1221.    xpos,ypos,size : integer;
  1222.   BEGIN
  1223.    Paint_Color( 0 );
  1224.    Paint_Style( 1 );
  1225.    Hide_Mouse;
  1226.    xpos := gzz_x+rgbsize+1;
  1227.    ypos := gzz_y+(( gun-1 ) * rgbsize )+1;
  1228.    size := rgbsize-2;
  1229.    Paint_Rect( xpos+( old_intensity * rgbsize ),ypos,size,size );
  1230.    Paint_Color( 1 );
  1231.    Paint_Rect( xpos+( new_intensity * rgbsize ),ypos,size,size );
  1232.    Show_Mouse;
  1233.    Delay( 50 );
  1234.    Attributes;
  1235.    old_intensity := new_intensity
  1236.   END;
  1237.   
  1238.  BEGIN
  1239.   intensity := ( mx-gzz_x ) DIV rgbsize;
  1240.   gun := (( my-gzz_y ) DIV rgbsize ) + 1;
  1241.   IF ( gun < 4 ) AND ( intensity < 10 ) THEN 
  1242.    BEGIN
  1243.     CASE intensity OF
  1244.      0:
  1245.       IF RGB[XBIOScolor][gun] > 0 THEN
  1246.        MoveBox( RGB[XBIOScolor][gun],RGB[XBIOScolor][gun]-1 );
  1247.      9:
  1248.       IF RGB[XBIOScolor][gun] < 7 THEN
  1249.        MoveBox( RGB[XBIOScolor][gun],RGB[XBIOScolor][gun]+1 );
  1250.      1,2,3,4,5,6,7,8:
  1251.       MoveBox( RGB[XBIOScolor][gun],intensity-1 )
  1252.     END;
  1253.     dummy := SetGetColor( GemToXbios( XBIOScolor ),
  1254.              ( RGB[XBIOScolor][1]*256 )+( RGB[XBIOScolor][2]*16 )+
  1255.                RGB[XBIOScolor][3] )
  1256.    END
  1257.  END; 
  1258.  
  1259. PROCEDURE DoText( keystate,origx,origy : integer );
  1260.  VAR
  1261.   keystring : Str255;
  1262.   stylemask,len : integer;
  1263.   
  1264.  PROCEDURE DrawText( xpos,ypos : integer );
  1265.   BEGIN
  1266.    Line( xpos-1,ypos,xpos-1,ypos-textsize );
  1267.    Draw_String( xpos,ypos,keystring )
  1268.   END;
  1269.   
  1270.  PROCEDURE Style( keymask,textmask : integer );
  1271.   BEGIN
  1272.    IF keystate & keymask <> 0 THEN
  1273.     stylemask := stylemask | textmask
  1274.   END;
  1275.    
  1276.  BEGIN
  1277.   WHILE Click( leftbutton ) DO  ;
  1278.   Begin_Mouse;
  1279.   Hide_Mouse;
  1280.   Draw_Mode( 3 );
  1281.   Line_Style( 1 );
  1282.   Line_Width( 1 );
  1283.   stylemask := 0;
  1284.   Style( alternate,Thickened );
  1285.   Style( control,Slanted );
  1286.   Style( leftshift,Outlined );
  1287.   Style( rightshift,Underlined );
  1288.   Text_Style( stylemask );
  1289.   keystring := '';
  1290.   DrawText( origx,origy );
  1291.   REPEAT
  1292.    event := EventMulti;
  1293.    IF ( mx <> origx ) OR ( my <> origy ) THEN
  1294.     BEGIN
  1295.      DrawText( origx,origy );
  1296.      DrawText( mx,my );
  1297.      origx := mx;
  1298.      origy := my
  1299.     END
  1300.    ELSE
  1301.     IF event & E_Keyboard <> 0 THEN
  1302.      BEGIN
  1303.       DrawText( origx,origy );
  1304.       len := LENGTH( keystring );
  1305.       IF key = Backspace THEN
  1306.        BEGIN
  1307.         IF len > 0 THEN
  1308.          DELETE( keystring,len,1 )
  1309.        END
  1310.       ELSE
  1311.        IF len < 255 THEN
  1312.         keystring := CONCAT( keystring,CHR( key ));
  1313.       DrawText( mx,my )
  1314.      END
  1315.   UNTIL Click( leftbutton );
  1316.   WHILE Click( leftbutton ) DO  ;
  1317.   DrawText( mx,my );
  1318.   Draw_Mode( drawmode );
  1319.   Draw_String( mx,my,keystring );
  1320.   Show_Mouse;
  1321.   End_Mouse;
  1322.   Attributes
  1323.  END;
  1324.  
  1325. PROCEDURE Sketch( keystate,mx,my : integer );
  1326.  BEGIN
  1327.   CASE mode OF
  1328.    draw:        DoDraw( keystate,mx,my );
  1329.    magnify:     DoMagnify( mx,my );
  1330.    circle,disc: DoCircle( keystate,mx,my );
  1331.    frame,box:   DoBox( keystate,mx,my );
  1332.    airbrush:    DoAirbrush;
  1333.    lines:       DoLine( keystate,mx,my );
  1334.    block:       BlockCopy( keystate,mx,my );
  1335.    fill:        DoPaint( mx,my );  
  1336.    text:        DoText( keystate,mx,my );
  1337.    pal:         SetRGB( mx,my )
  1338.   END
  1339.  END;
  1340.  
  1341.  PROCEDURE Disk( operation : integer );
  1342.   CONST
  1343.    NEO = 2;
  1344.   VAR
  1345.    H,i,header,colors,offset : integer;
  1346.    header_addr,count : long_integer;
  1347.    format : String[60];
  1348.    TM : char;
  1349.   BEGIN
  1350.    header := 34;
  1351.    colors := 34;
  1352.    offset := 2;
  1353.    TM := CHR( $BF );
  1354.    format := CONCAT('[2][ | |     Which Format?     | ][ DEGAS',TM,
  1355.                     ' | NEOchrome',TM,' ]' );
  1356.    IF rez = 0 THEN
  1357.     IF Do_Alert( format,0 ) = NEO THEN
  1358.      BEGIN
  1359.       header := 128;
  1360.       colors := 36;
  1361.       offset := 4
  1362.      END;
  1363.    IF Get_In_File( path,p_name ) THEN
  1364.     BEGIN
  1365.      Set_Mouse( M_Bee );
  1366.      CASE operation OF
  1367.       LoadPic:
  1368.        BEGIN
  1369.         Reset( Input,p_name );
  1370.         IF EOF( Input ) THEN
  1371.          LoadError
  1372.         ELSE
  1373.          BEGIN
  1374.           H := Handle( Input );
  1375.           count := F_Seek( 0,H,0 ); 
  1376.           count := F_Read( H,colors,pic_start );
  1377.           SetPalette( pic_start+offset );
  1378.           Delay( 60 );
  1379.           SavePalette;
  1380.           count := F_Seek( header,H,0 );
  1381.           count := F_Read( H,32000,picture );
  1382.           Close( Input );
  1383.           IF count <> 32000 THEN
  1384.            LoadError
  1385.          END
  1386.        END;
  1387.       SavePic:  
  1388.        BEGIN
  1389.         P_TO_CSTR( p_name,c_name );
  1390.         H := F_Create( c_name,0 );
  1391.         IF  H >= 0  THEN                 { Error? }
  1392.          BEGIN
  1393.           IF picture-pic_start >= header THEN
  1394.            header_addr := pic_start
  1395.           ELSE
  1396.            header_addr := picture+32000;
  1397.           FOR i := 0 TO header-1 DO
  1398.            POKE( header_addr+i,0 );
  1399.           WPOKE( header_addr,rez );
  1400.           MOVE_WORD( Addr_Palette( sketchcolors ),header_addr+offset,16 );
  1401.           count := F_Seek( 0,H,2 ); 
  1402.           count := F_Write( H,header,header_addr );
  1403.           count := F_Seek( 0,H,2 );
  1404.           count := F_Write( H,32000,picture );
  1405.           dummy := F_Close( H );
  1406.           IF count <> 32000 THEN
  1407.            SaveError
  1408.          END
  1409.         ELSE
  1410.          SaveError
  1411.        END
  1412.      END;
  1413.      Set_Mouse( M_Arrow )
  1414.     END
  1415.   END;
  1416.  
  1417.  FUNCTION Chosen( dialogptr : Dialog_Ptr; index : integer ) : boolean;
  1418.   BEGIN
  1419.    Chosen := Obj_State( dialogptr,index ) & 1 <> 0
  1420.   END;
  1421.    
  1422. PROCEDURE SetOptions;
  1423.  VAR
  1424.   i : integer;
  1425.  BEGIN
  1426.   FOR i := narrow TO wide DO
  1427.    IF Chosen( dialog2_ptr,i ) THEN
  1428.     coverage := i;
  1429.    CASE coverage OF
  1430.     narrow: coverage := 7;
  1431.     medium: coverage := 31;
  1432.     wide:   coverage := 63
  1433.    END;
  1434.     
  1435.   FOR i := heavy TO light DO
  1436.    IF Chosen( dialog2_ptr,i ) THEN
  1437.     saturation := i;
  1438.   CASE saturation OF
  1439.    heavy:    saturation := 0;
  1440.    moderate: saturation := 35;
  1441.    light:    saturation := 70
  1442.   END;
  1443.  
  1444.   FOR i := line1 TO line6 DO
  1445.    IF Chosen( dialog2_ptr,i ) THEN
  1446.     linestyle := i-( line1-1 );
  1447.   Line_Style( linestyle );
  1448.   
  1449.   FOR i := brush1 TO brush6 DO
  1450.    IF Chosen( dialog2_ptr,i ) THEN
  1451.     BEGIN
  1452.      brushwidth := (( i-brush1 )*4 )+1;
  1453.      CASE i OF
  1454.       brush1: textsize := 3;
  1455.       brush2: textsize := 4;
  1456.       brush3: textsize := 6;
  1457.       brush4: textsize := 12;
  1458.       brush5: textsize := 13;
  1459.       brush6: textsize := 26
  1460.      END 
  1461.     END;
  1462.   brusheight := brushwidth DIV aspect;
  1463.   Line_Width( brushwidth );
  1464.   bitsize := brushwidth+1;
  1465.   Limit( bitsize,6,22 )
  1466.  END;
  1467.  
  1468. PROCEDURE OptionDialog;
  1469.  VAR
  1470.   option_button : Tree_Index;
  1471.  BEGIN
  1472.   Center_Dialog( dialog2_ptr );
  1473.   option_button := Do_Dialog( dialog2_ptr,0 );
  1474.   Obj_Setstate( dialog2_ptr,ok2,Normal,TRUE );
  1475.   End_Dialog( dialog2_ptr );
  1476.   SetOptions
  1477.  END;
  1478.  
  1479. PROCEDURE SketchDialog;
  1480.  VAR
  1481.   i,clear_picture : integer;
  1482.   sketch_button  : Tree_Index;
  1483.   
  1484.  BEGIN
  1485.   Begin_Mouse;
  1486.   Blit_to_Memory;
  1487.   Center_Dialog( dialog1_ptr );
  1488.   sketch_button := Do_Dialog( dialog1_ptr,0 );
  1489.   LOOP
  1490.    clear_picture := 0;
  1491.    IF Chosen( dialog1_ptr,load ) THEN
  1492.     BEGIN
  1493.      Obj_Setstate( dialog1_ptr,load,Normal,TRUE );
  1494.      Disk( LoadPic );
  1495.      Show_Dialog( dialog1_ptr,0 )
  1496.     END
  1497.    ELSE 
  1498.     IF Chosen( dialog1_ptr,save ) THEN
  1499.      BEGIN
  1500.       Obj_Setstate( dialog1_ptr,save,Normal,TRUE );
  1501.       Disk( SavePic );
  1502.       Show_Dialog( dialog1_ptr,0 )
  1503.      END;
  1504.  
  1505.    IF Chosen( dialog1_ptr,wipe ) THEN
  1506.     BEGIN
  1507.      Obj_Setstate( dialog1_ptr,wipe,Normal,TRUE );
  1508.      clear_picture := Do_Alert
  1509.      ('[3][ |  Wipe Picture?   |  Are You Sure?  | ][ Yes | No ]',1 );
  1510.      IF clear_picture = 1 THEN
  1511.       BEGIN
  1512.        ClearWindow;
  1513.        ClearPic
  1514.       END
  1515.     END;
  1516.  
  1517.    IF Chosen( dialog1_ptr,option ) THEN
  1518.     BEGIN
  1519.      Obj_Setstate( dialog1_ptr,option,Normal,TRUE );
  1520.      OptionDialog;
  1521.      Show_Dialog( dialog1_ptr,0 );
  1522.      sketch_button := 0
  1523.     END;
  1524.   
  1525.    EXIT IF ( clear_picture = 1 ) OR ( sketch_button = OK1 );
  1526.    sketch_button := Redo_Dialog( dialog1_ptr,0 )
  1527.   END;
  1528.   Obj_Setstate( dialog1_ptr,wipe,Normal,TRUE );
  1529.   Obj_Setstate( dialog1_ptr,ok1,Normal,TRUE );
  1530.   End_Dialog( dialog1_ptr );
  1531.  
  1532.   IF Chosen( dialog1_ptr,clear ) THEN
  1533.    drawmode := transparent_mode
  1534.   ELSE
  1535.    drawmode := opaque_mode;
  1536.   Draw_Mode( drawmode );
  1537.   blitmode := SHORT_TRUNC( 3.5 * drawmode );
  1538.     
  1539.   FOR i := draw TO text DO
  1540.    IF Chosen( dialog1_ptr,i ) THEN
  1541.     mode := i;
  1542.   
  1543.   ScrollBars;
  1544.   ChangeInfo;
  1545.   End_Mouse
  1546.  END;
  1547.  
  1548. PROCEDURE Options;
  1549.  BEGIN
  1550.   Begin_Mouse;
  1551.   Blit_to_Memory;
  1552.   OptionDialog;
  1553.   ScrollBars;
  1554.   End_Mouse
  1555.  END;
  1556.  
  1557. PROCEDURE GetEvent;
  1558.  VAR
  1559.   handle,xpos,ypos,width,height : integer;
  1560.   log,dummy : long_integer;
  1561.   
  1562.  PROCEDURE Arrow( VAR xpos,ypos,v_slide,h_slide : integer; 
  1563.                   x_limit,y_limit,x_slide,y_slide,x_inc,y_inc : integer );
  1564.   BEGIN
  1565.    CASE msg[4] OF
  1566.     0: BEGIN  ypos := 0;          v_slide := 1                END;
  1567.     1: BEGIN  ypos := y_limit;    v_slide := 1000             END;
  1568.     2: BEGIN  ypos := ypos-y_inc; v_slide := v_slide-y_slide  END;
  1569.     3: BEGIN  ypos := ypos+y_inc; v_slide := v_slide+y_slide  END;
  1570.     4: BEGIN  xpos := 0;          h_slide := 1                END;
  1571.     5: BEGIN  xpos := x_limit;    h_slide := 1000             END;
  1572.     6: BEGIN  xpos := xpos-x_inc; h_slide := h_slide-x_slide  END;
  1573.     7: BEGIN  xpos := xpos+x_inc; h_slide := h_slide+x_slide  END
  1574.    END;       
  1575.    Limit( ypos,0,y_limit );
  1576.    Limit( xpos,0,x_limit );
  1577.    Limit( v_slide,1,1000 );
  1578.    Limit( h_slide,1,1000 );
  1579.    Wind_Set( window,WF_HSlide,h_slide,0,0,0 );
  1580.    Wind_Set( window,WF_VSlide,v_slide,0,0,0 )
  1581.   END;
  1582.  
  1583.  
  1584.  BEGIN
  1585.   event  := EventMulti;
  1586.   handle := Front_Window;
  1587.   
  1588.   IF handle = window THEN
  1589.    BEGIN
  1590.     IF Click( rightbutton ) THEN
  1591.      BEGIN
  1592.       Begin_Mouse;
  1593.       Blit_to_Memory;
  1594.       screen := Physbase;
  1595.       log := Logbase;
  1596.       SetScreen( picture,picture,-1 );
  1597.       MouseVector( oldmouse,dummy );
  1598.       Set_Clip( 0,0,xmax+1,ymax+1 );
  1599.       WHILE Click( rightbutton ) DO  ;
  1600.       WHILE NOT Click( rightbutton ) DO
  1601.        IF int_out[3] & leftbutton <> 0 THEN
  1602.         CASE mode OF
  1603.          magnify,pal,block:  ;
  1604.          OTHERWISE:  Sketch( int_out[4],int_out[1],int_out[2] )
  1605.         END;
  1606.       WHILE Click( rightbutton ) DO  ;
  1607.       TrapMouse;
  1608.       SetScreen( log,screen,-1 );
  1609.       Set_Clip( gzz_x,gzz_y,gzz_w,gzz_h );
  1610.       Blit_to_Screen;
  1611.       End_Mouse
  1612.      END
  1613.     END
  1614.    ELSE
  1615.     IF keystate & ShiftAltCntrl = ShiftAltCntrl THEN
  1616.      BEGIN
  1617.       Hide_Mouse;
  1618.       screen := Physbase;
  1619.       SetScreen( -1,picture,-1 );
  1620.       Delay( 500 );
  1621.       Work_Rect( handle,xpos,ypos,width,height );
  1622.       CopyRaster( screen,picture,xpos,ypos,xpos,ypos,xpos,ypos,
  1623.                   width,height,blitmode );
  1624.       IF keystate & rightshift <> 0 THEN
  1625.        SavePalette;
  1626.       WHILE keystate & ShiftAltCntrl <> 0 DO
  1627.        event := EventMulti;
  1628.       SetScreen( -1,screen,-1 );
  1629.       Show_Mouse
  1630.      END;
  1631.       
  1632.  
  1633.   IF event & E_Message <> 0 THEN
  1634.    CASE msg[0] OF
  1635.  
  1636.     AC_Open:
  1637.      IF window = No_Window THEN
  1638.       SketchOn;
  1639.       
  1640.     AC_Close:
  1641.      IF window <> No_Window THEN
  1642.       window := No_Window;
  1643.       
  1644.     WM_Closed:      
  1645.      SketchOff;
  1646.  
  1647.     WM_Redraw:
  1648.      Redraw;
  1649.  
  1650.     WM_Arrowed:
  1651.      BEGIN
  1652.       Blit_to_Memory;
  1653.       CASE mode OF
  1654.        magnify:
  1655.         WITH mag DO 
  1656.          Arrow( x_offset,y_offset,v_slide,h_slide,x_limit,y_limit,
  1657.                 x_slide,y_slide,x_inc,y_inc );
  1658.        pal:  ;
  1659.        OTHERWISE:
  1660.         WITH wind DO
  1661.          Arrow( x_offset,y_offset,v_slide,h_slide,x_limit,y_limit,
  1662.                 x_slide,y_slide,x_inc,y_inc )
  1663.       END;
  1664.       Redraw
  1665.      END;
  1666.     
  1667.     WM_HSlid:
  1668.      BEGIN
  1669.       Blit_to_Memory;
  1670.       CASE mode OF
  1671.        magnify:
  1672.         WITH mag DO
  1673.          BEGIN
  1674.           h_slide := msg[4]+1;
  1675.           x_offset := Slider( h_slide,x_limit,WF_HSlide )
  1676.          END;
  1677.        pal: ;
  1678.        OTHERWISE:
  1679.         WITH wind DO
  1680.          BEGIN
  1681.           h_slide := msg[4]+1;
  1682.           x_offset := Slider( h_slide,x_limit,WF_HSlide )
  1683.          END     
  1684.       END;
  1685.       Redraw
  1686.      END; 
  1687.      
  1688.     WM_VSlid:
  1689.      BEGIN
  1690.       Blit_to_Memory;
  1691.       CASE mode OF
  1692.        magnify:
  1693.         WITH mag DO
  1694.          BEGIN
  1695.           v_slide := msg[4]+1;
  1696.           y_offset := Slider( v_slide,y_limit,WF_VSlide )
  1697.          END;
  1698.        pal: ;
  1699.        OTHERWISE:
  1700.         WITH wind DO
  1701.          BEGIN
  1702.           v_slide := msg[4]+1;
  1703.           y_offset := Slider( v_slide,y_limit,WF_VSlide )
  1704.          END
  1705.       END;
  1706.       Redraw
  1707.      END
  1708.    END;     
  1709.  
  1710.    IF event & E_Keyboard <> 0 THEN
  1711.     CASE key OF
  1712.      F1,Help:
  1713.       SketchDialog;
  1714.      F2:
  1715.       Options;
  1716.      Escape:
  1717.       SketchOff;
  1718.      Undo: 
  1719.       IF mode = pal THEN
  1720.        BEGIN
  1721.         SetPalette( Addr_Palette( sketchcolors ));
  1722.         Delay( 60 );
  1723.         StoreColors;
  1724.         ClearWindow;
  1725.         ColorPanel
  1726.        END
  1727.       ELSE
  1728.        Blit_to_Screen;
  1729.      Tab:
  1730.       IF rez = 2 THEN
  1731.        BEGIN
  1732.         dummy := SetGetColor( 0,( ~SetGetColor( 0,-1 ) & $777 ));
  1733.         GetColors( sketchcolors )
  1734.        END
  1735.     END;
  1736.     
  1737.    IF event & E_MRect_1 <> 0 THEN      
  1738.     IF event & E_Button <> 0 THEN
  1739.      BEGIN
  1740.       IF my < ( y+inkwell_height+2 ) THEN
  1741.        BEGIN
  1742.         IF mx < ( x+patternspot-1 ) THEN
  1743.          SetColor( mx )
  1744.         ELSE
  1745.          BEGIN
  1746.           IF mx < Fx THEN
  1747.            SetPattern( keystate )
  1748.           ELSE
  1749.            BEGIN
  1750.             IF mx < Ox THEN
  1751.              SketchDialog
  1752.             ELSE
  1753.              Options
  1754.            END
  1755.          END
  1756.        END
  1757.       ELSE
  1758.        Sketch( keystate,mx,my )
  1759.      END
  1760.   END;
  1761.  
  1762.  
  1763.   BEGIN
  1764.    ap_id := Init_Gem;
  1765.     IF ap_id >= 0 THEN
  1766.      BEGIN
  1767.       desk_name := '  MultiPaint ';
  1768.       menu_id := Menu_Register( ap_id,desk_name );
  1769.       IF getrez < 2 THEN
  1770.        resource := 'color.rsc'
  1771.       ELSE
  1772.        resource := 'mono.rsc';
  1773.       IF Load_Resource( resource ) THEN
  1774.        BEGIN
  1775.         Find_Dialog( dialog1,dialog1_ptr );
  1776.         Find_Dialog( dialog2,dialog2_ptr )
  1777.        END
  1778.       ELSE
  1779.        WHILE TRUE DO
  1780.         IF EventMulti & E_Message <> 0 THEN
  1781.          dummy := Do_Alert( '[1][ | | No Resource File! | ][ Cancel ]',1 );
  1782.       window := No_Window;
  1783.       Initialize;
  1784.       WHILE TRUE DO
  1785.        GetEvent
  1786.      END
  1787.   END.
  1788.